home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / MARYLAND / P1-1992.PAS next >
Encoding:
Pascal/Delphi Source File  |  1993-01-31  |  2.3 KB  |  78 lines
  1. {*****************************************************************************}
  2. {                                                                             }
  3. {                   Bit-image scaler by scaling factor                        }
  4. {                                   by                                        }
  5. {                          Fernando Luis Padilla                              }
  6. {       (c), Copyrighted to above stated author, December 23, 1992            }
  7. {                                                                             }
  8. {*****************************************************************************}
  9.  
  10. program scalingII;
  11. uses
  12.      crt;
  13. const
  14.       pausechar=chr(2);
  15.  
  16.  
  17. procedure firststep(var batchfile:text;  var hatchfile:text);
  18. var
  19.      a:integer;
  20.      scale:integer;
  21.      tempchar:char;
  22.      tempstring:string[80];
  23. begin
  24.      while not eof(batchfile) do begin
  25.           write('+');
  26.           readln(batchfile,scale);
  27.           while not((eoln(batchfile)) or (eof(batchfile))) do begin
  28.                write('=');
  29.                tempstring:='';
  30.                while not((eoln(batchfile)) or (eof(batchfile))) do begin
  31.                     read(batchfile,tempchar);
  32.                     for a:=1 to scale do tempstring:=concat(tempstring,tempchar);
  33.                end;
  34.                readln(batchfile);
  35.                for a:=1 to scale do writeln(hatchfile,tempstring);
  36.           end;
  37.           writeln(hatchfile,pausechar);
  38.      end;
  39.      writeln;
  40. end;
  41.  
  42. procedure output(var hatchfile:text);
  43. var
  44.      tempstring:string[80];
  45. begin
  46.      repeat
  47.           readln(hatchfile,tempstring);
  48.           case tempstring[1] of
  49.                pausechar:begin
  50.                     writeln;
  51.                     readln;
  52.                end
  53.                else writeln(tempstring);
  54.           end;
  55.      until eof(hatchfile);
  56. end;
  57.  
  58. procedure control;
  59. var
  60.      batchfile:text;
  61.      hatchfile:text;
  62. begin
  63.      assign(batchfile,'a:p1-data.dat');
  64.      reset(batchfile);
  65.      assign(hatchfile,'a:tempfile.dat');
  66.      rewrite(hatchfile);
  67.      clrscr;
  68.      firststep(batchfile,hatchfile);
  69.      close(batchfile);
  70.      reset(hatchfile);
  71.      output(hatchfile);
  72.      close(hatchfile);
  73.      erase(hatchfile);
  74. end;
  75.  
  76. begin
  77.      control;
  78. end.